;GTJSMX.MAC;2 15-Apr-81 16:13:50, Edit by MMCM ; Correct XCTUU's to XCTBU on byte instructions (same on KI, diff on F2) ;GTJSMX.MAC;1 18-Mar-81 21:50:14, Edit by MMCM ;GTJSMX.MAC;1 2/26/80 EDIT BY RINDFLEISCH ; Code for SUMEX changes to GTJFN ; GTJFN assembly continues here... ; Indices into extended long GTJFN table (LLTBF flag on in long call) EXTWD=11 ; LH = ctl bits,,RH = # words following TPPTR=12 ; Typescript string pointer TPCNT=13 ; Max typescript characters PRPTR=14 ; Prompt string pointer ; A "retype" buffer is allocated in the JSB free space to hold additional ; control words (first 5 entries) and a typescript of the user's input ; text. Following are symbols relating to its contents ; Retype buffer size parameters MAXRW==:^D30+BLKDT ; Retype buffer size in words MAXRC==:<5*-1> ; Retype buffer size in characters ; Indices into retype buffer locations BLKBP=1 ; Retype bfr indx - current byte ptr BLKCT=2 ; Retype bfr indx - retype char count remaining BLKFG=3 ; Retype bfr indx - retype/user flags USRBP=4 ; Retype bfr indx - current user typescript ptr USRCT=5 ; Retype bfr indx - user typescript buffer size BLKDT=6 ; Retype bfr indx - first input text word ; Flags used in the retype buffer word BLKFG ; LEFT HALF LITRF=400000 ; Do literal retype of what has been entered DEVRF=200000 ; Non-std default Device - not in retype buffer DIRRF=100000 ; Non-std default Directory - not in retype buffer USRTY=040000 ; User requested copy of typescript (long GTJFN) USRPR=020000 ; User supplied prompt for insertion in retype ; RIGHT HALF (Fetched and returned to LH of extended table word 11) BRDEL=400000 ; On means break if try to delete past input start MAX6F=100000 ; On means names le 6 and ext le 3 chars (not imp) TPCNF=040000 ; On means return confirmation message with typescript FNNAM=020000 ; File is on a no name device FNVER=010000 ; File has a name but no version numbers FNEWF=004000 ; File is new FNEWV=002000 ; File is a new version ; Flags used in DECBUF routine (returned in LH of decremented char) CTVCHR=400000 ; Deleted char was quoted FILTDN=200000 ; FILTMP was empty when deleting this char NDIG=6 ; Max number of digits in prot and acct ; This routine performs a comparison between an input string and a ; "library" string. Case is ignored ("Ab" = "aB). The input string ; may contain the characters "*" and "%" as "wild cards". ; "*" means match anything up to the next non-wild card input character. ; "%" means match any one character in the next input slot. ; All strings are ASCIZ. ^V quotes any input character. ; ; For example, given the library string "ABCDEFG", ; ; "ABC*" would match ; "%ABC*" would not match ; "%B%DE*" would match ; ; On entry: ; AC 1 = string pointer to input ; 2 = string pointer to library ; ; Returns: ; +1 No match ; +2 Wild card match ; ; Clobbers A,B,C,D WCNOW=1B0 ;on means the last character was a * INPDN=1B1 ;on means the input string is exhausted LIBDN=1B2 ;on means the library string is exhausted WCCMP:: PUSH P,STS ;SAVE AC PUSH P,[0] ;INPUT PTR AFTER * PUSH P,[0] ;LIBRARY PTR AFTER * SETZ STS, ;CLEAR STATUS ; Get an input string char WCCMP0: ILDB C,A ;GET THE NEXT INPUT CHAR JUMPE C,[TLO STS,(INPDN) ;IF 0, SET INPUT DONE FLAG TLNN STS,(WCNOW) ;LAST CHAR A *? JRST WCCMP1 ;NO, CHECK LIBRARY STRING TLO STS,(LIBDN) ;YES, FAKE LIBRARY DONE TOO JRST WCCMP3] ;AND QUIT CAIN C,"*" ;UNLIMITED WILD CARD? JRST [TLO STS,(WCNOW) ;YES, SET FLAG MOVEM A,-1(P) ;SAVE INPUT PTR MOVEM B,0(P) ;SAVE LIBRARY PTR JRST WCCMP0] ;GO TRY FOR MORE INPUT CAIN C,"%" ;SINGLE WILD CHARACTER? JRST [ILDB D,B ;GET ANY NEXT CHAR JUMPN D,WCCMP0 ;IF NOT END, MOVE ON TLO STS,(LIBDN) ;LIBRARY DONE JRST WCCMP3] ;WRAP IT UP CAIN C,<"V"-100> ;QUOTED CHAR? JRST [ILDB C,A ;YES, GET NEXT ONE WHATEVER JUMPN C,WCCMP1 ;IF NON-0, LOOK AT LIBRARY TLO STS,(INPDN) ;INPUT DONE, SET BIT JRST WCCMP1] ;AND CONTINUE ; Get a library string char WCCMP1: ILDB D,B ;FETCH THE NEXT LIBRARY CHAR JUMPE D,[TLO STS,(LIBDN) ;IF END OF LIBRARY, FLAG IT JRST WCCMP3] ;AND TALLY RESULTS CAME C,D ;OK, DOES INP CHAR MATCH LIB CHAR? JRST WCCMP2 ;NO, SEE ABOUT USING WILD CHAR TLZ STS,(WCNOW) ;TURN OFF RECENT WILD CARD BIT JRST WCCMP0 ;TRY NEXT INPUT CHAR ; Here a mismatch was found. Check to see if we should quit or search ; further, using any wild cards to span the mismatch. WCCMP2: SKIPN A,-1(P) ;PREVIOUS *? JRST WCCMP3 ;NO, QUIT IBP 0(P) ;YES, BUMP LIB PTR TO SPAN MISMATCH MOVE B,0(P) ;AND RECOVER IT TLZ STS,(INPDN!LIBDN) ;CLEAR END OF INPUT FLAGS JRST WCCMP0 ;AND TRY AGAIN ; Here we have either a match or done everything possible to find one. ; Tally up the results and compute the proper skip return. WCCMP3: SUB P,[2,,2] ;RESET STACK MOVE C,STS ;SAVE STATUS POP P,STS TLNE C,(INPDN) ;DID WE FINISH THE INPUT? TLNN C,(LIBDN) ;AND THE LIBRARY? POPJ P, ;NO, RETURN +1 AOS 0(P) ;YES, RETURN +2 POPJ P, ; Routine to locate a file version with acceptable access privileges ; Entry: A = desired version number ; JFN, F, F1, DEV, and STS are set up appropriately ; Return: +1 - Error, no accessible file found ; +2 - Success, A = version number, B = FDB ctl bits ; ; Access check: ; IF NEW file or version, ; ability to create it checked elsewhere, accept it ; IF OLD file, ; IF NAMSF = TRUE (wild card name), require PT access on in protection ; IF NAMSF = FALSE (specific name) ; IF Login or Connected directory, always allow access ; IF any other directory, require some access bit on in ; appropriate group/other field GTVER: HRRZ B,NLUKD(DEV) ; Is this a multi directory device? CAIN B,MDDNAM JRST GTVER1 ; Yes PUSHJ P,VERLUK ; No, don't bother leaving it locked POPJ P, ; Couldn't find it - return +1 SETZ B, ; Got it, clear ctl bits GTVER0: TEST(O,VERF,VERTF) ; Show version found HRRM A,FILVER(JFN) ; Install version JRST SKPRET ; And return +2 GTVER1: PUSHJ P,VERLKX ; Lookup requested version - return FDB POPJ P, ; Couldn't get one - return +1 TEST(NE,ASTF) ; If output stars, nothing really done JRST GTVER0 ; Save the version and return PUSH P,FDBCTL(A) ; Got one, save the FDB ctl bits PUSH P,FDBVER(A) ; And save the version number TEST(NE,NEWF,NEWVF) ; New file or version? JRST GTVER2 ; Yes, just take it HRLI A,-1 ; No, do access check PUSHJ P,ACCCHK JRST GTVER3 ; Bad news, see if we can try another GTVER2: TEST(O,VERF,VERTF) ; Show version found and typed POP P,A ; Recover version number POP P,B ; Recover FDB ctl bits HLRZS A HRRM A,FILVER(JFN) ; And install it PUSHJ P,USTDIR ; OK, release the directory JRST SKPRET ; And return +2 GTVER3: PUSHJ P,USTDIR ; Invalid access, release directory POP P,A ; recover this version number HLRZS A SUB P,[1,,1] ; And clear ctl bits from stack TLNN F1,DIRSF!NAMSF!EXTSF!VERSF ; Stepping anything? POPJ P, ; No, return +1 TEST(O,STEPF) ; Yes, step to the next file TEST(NE,RVERF) ; after installing right target version MOVEI A,0 TEST(NE,HVERF) MOVEI A,-1 TEST(NE,LVERF) MOVEI A,-2 JRST GTVER ; Now go try it ; Initiate a rescan of the user's input (from the retype buffer). The ; JFN block is initialized and a flag is set so the input scanner begins ; looking at the retype buffer as input. ; Entry: File name strings in process of being collected ; Call: PUSHJ P,RESCAN ; Return: +1 always, JFN reinited, RSCNF set RESCAN: NOINT HRRZ A,FILEXW(JFN) ; Preserve retype buffer info PUSH P,A HLLZS FILEXW(JFN) ; Now make believe it isn't there PUSHJ P,RELJFN ; Go clean up PUSHJ P,ASGJFN ; Go get another JRST [MOVEI A,JSBFRE ; Oops, no more left POP P,B ; Release retype buffer SKIPE B PUSHJ P,RELFRE ERR(GJFX3)] ; And bomb out POP P,FILEXW(JFN) ; Set up old retype stuff OKINT ; Interrupts again XCTUU [HLLZ F,0(E)] ; Fetch his flags again MOVEI F1,0 ; And clear others TEST(NN,TMPFF) ; Temp file specified? TEST(O, SCRF) ; No, then try for normal versions CHRTP(0) ; Better be sure retype terminated TEST(O,RSCNF) ; Turn for rescan of input PUSHJ P,SETRTP ; Reinit retype buffer pointers JRST SETTMP ; Get another temp block and continue ; Delete chars from the input buffers until FILTMP is empty. ; Entry: Input string in FILTMP and RETYPE ; Call: PUSHJ P,CNTFLD ; Return: +1 always, D = Count of chars backspaced (to start of field) ; Retype and typescript ptrs point to the start of this field. ; Clobbers A,B,C,D CNTFLD: PUSH P,[0] ; Create a temporary counter CNTFL0: PUSHJ P,DECBUF ; Decrement the buffer once JRST CNTFL1 ; OK, no more chars anywhere AOS 0(P) ; Got rid of one char, note it TLNN A,FILTDN ; FILTMP empty? JRST CNTFL0 ; No, do another one CNTFL1: POP P,D ; Get count of chars backspaced POPJ P, ; Routine to decrement a 7 bit byte pointer. ; Entry: A contains the byte ptr ; Call: PUSHJ P,DECBP ; Return: +1 always, updated byte ptr in A DECBP: ADD A,[070000,,0] ; Back up TLNE A,(1B0) ; Overflow? SUB A,[430000,,1] ; Yes, fix it up POPJ P, ; Routine to decrement input buffers 1 effective character position. ; The buffers affected include: ; Retype buffer ptr in FILEXW(JFN) ; User typescript ptr in retype buffer block (if any) ; Temporary block ptr in FILTMP(JFN) ; Entry: Input string being collected ; Call: PUSHJ P,DECBUF ; Returns +1 Nothing more to delete ; +2 One character accounted for - ; RH(A) = character deleted ; LH(A) = flags ; CTVCHR Char quoted (preceeded by an odd number of ^V's) ; FILTDN FILTMP was empty before this char deleted ; If FILTMP was empty on entry, RSCNF is set ; Clobbers A,B,C,D DECBUF: HRRZ D,FILEXW(JFN) ; Get retype buffer SKIPG D POPJ P, ; Oops, none there. MOVEI C,MAXRC ; Compute chars in retype buffer SUB C,BLKCT(D) SKIPG C ; Anything there? POPJ P, ; No, tell him all clear at +1 AOS 0(P) ; Got at least one, return +2 ; First do the retype buffer MOVE A,BLKBP(D) ; ptr to current char in retype SETZ B, ; Counter for ^V's DECBF0: SOJLE C,DECBF1 ; If no PRECEEDING chars, move on PUSHJ P,DECBP ; Have one, decrement byte ptr LDB D,A ; What is it? CAIE D,<"V"-100> ; ^V? JRST DECBF1 ; No, quit looking AOJA B,DECBF0 ; Yes, count it and look for more DECBF1: HRRZ D,FILEXW(JFN) ; Restore retype ptr MOVE A,BLKBP(D) ; Get current byte ptr LDB C,A ; And the character TRNE B,1 ; Odd number of ^V's? TLO C,CTVCHR ; Yes, add flag PUSHJ P,DECBP ; Back up one for real AOS BLKCT(D) JUMPL C, [PUSHJ P,DECBP ; ^V, need one more AOS BLKCT(D) JRST .+1] MOVEM A,BLKBP(D) ; Update it permanently ; Now do the user typescript MOVE A,BLKFG(D) ; Get flags TLNN A,USRTY ; Typescript active? JRST DECBF2 ; No, just do temp block MOVE A,USRBP(D) ; Get user's byte ptr PUSH P,C ; Save coded character PUSHJ P,DBP ; Do general decrement - may not be 7 bit AOS USRCT(D) ; And his count SKIPG 0(P) ; ^V too? JRST [PUSHJ P,DBP ; Yes AOS USRCT(D) JRST .+1] MOVEM A,USRBP(D) ; Save it for later POP P,C ; And recover the character ; Finally do the temporary block DECBF2: MOVE A,FILCNT(JFN) ; Get count remaining CAIL A,MAXLC ; Anything in the buffer? JRST [TLO C,FILTDN ; Show FILTMP was empty JRST DECBF3] MOVE A,FILOPT(JFN) ; Get the current byte ptr PUSHJ P,DECBP ; Decrement it MOVEM A,FILOPT(JFN) ; And return it AOS FILCNT(JFN) ; Bump the count TEST(NN,NUMFF) ; Entering a number? JRST DECBF3 ; No, carry on MOVE A,NUM ; Yes, decrement it MOVEI B,^D8 ; Octal for now TEST(NN,OCTF) ; Really decimal? MOVEI B,^D10 ; Yes IDIV A,B ; Reduce the number MOVE NUM,A ; And return the new value ; Done, return char and flags in A DECBF3: MOVE A,C ; All done - put "deleted" char in A POPJ P, ; Routines to handle user question mark input. Entered from input char ; dispatch table. If the input is non-TTY or output NIL, returns ; immediately. Otherwise, list the candidates for the field currently ; being entered if no previous field had a wild card. If no candidates ; are found, break with an error. Scan for candidates is terminated on ; last one or on any input from the user. QUEST: HRRZ B,FILEXW(JFN) ; Save the retype buffer status MOVE A,BLKCT(B) ; Anything typed yet? CAIL A,MAXRC ERRLJF GJFX34 ; No, then break on "?" MOVE A,BLKFG(B) ; Get user flags TLNN A,USRTY ; User typescript? JRST QUEPSH ; No, just go save retype context XCTUU [MOVE A,TPPTR(E)] ; Yes, get his real typescript data and PUSH P,A ; Save it for later XCTUU [MOVE A,TPCNT(E)] PUSH P,A QUEPSH: PUSH P,BLKBP(B) ; Save retype bfr stuff PUSH P,BLKCT(B) PUSH P,BLKFG(B) PUSH P,USRBP(B) PUSH P,USRCT(B) PUSHJ P,GSIBE ; Check for anything in input (OR NON-TTY) JRST QUEST2 ; Oops, wants us back XCTUU [HRRZ A,1(E)] ; Check for output JFN TLNE E,777777 TLNE E,2 CAIN A,377777 JRST QUEST2 ; Can't do it TEST(NN,DEVF) ; Device specified? PUSHJ P,DEFDEV ; No, get a default MOVE B,DLUKD(DEV) ; Has to be multi dir CAIE B,MDDDIR JRST QUEST2 ; Oops, ding him and restart MOVE B,[BYTE (2)0,0,0,0,0,0,0,2,0,0,2,0,0,2,0,0,0,0] ; Set TTY COCs MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2] PUSHJ P,SFCC ; Output CRLF, EOL, and bells TEST(O,NREC) ; Suppress other printout ;;; MOVEI A,"?" ; Fix user's typescript in case error ;;; PUSHJ P,USRCH ; Show he typed ? PUSHJ P,TRMUTP ; Terminate it HRRZ A,FILEXW(JFN) ; And turn off more typescript for now MOVSI B,USRTY ANDCAM B,BLKFG(A) TEST(NE,DIRFF) ; Dispatch on entery state - directory? JRST QDIR ; Yes TEST(NE,EXTFF) ; Extension? JRST QEXT ; Yes TEST(NN,NAMF) ; Have a name? JRST QNAM ; No, must be entering it TEST(NN,VERF) ; Have a version? JRST QVER ; No, must be entering it QUEST0: PUSHJ P,GSIBE ; Anything typed? SKIPA ; Yes, eat it JRST QUEST3 ; No, just retype and return QUEST1: XCTUU [HRRZ A,1(E)] ; Something was typed to stop output CFOBF ; Clear output buffer XCTUU [HLRZ A,1(E)] ; Then point to input and RFMOD ; Break on everything so we can eat it PUSH P,B TRZ B,777700 IORI B,174100 SFMOD BIN ; Get the input and throw it away POP P,B ; Reset mode word SFMOD QUEST2: PUSHJ P,DING ; Can't help in any later fields QUEST3: HRRZ B,FILEXW(JFN) ; Restore retype buffer status POP P,USRCT(B) POP P,USRBP(B) POP P,BLKFG(B) POP P,BLKCT(B) POP P,BLKBP(B) MOVE A,BLKFG(B) ; Get user flags TLNN A,USRTY ; User typescript? JRST QUEST4 ; No, just go do the retype and rescan POP P,A ; Yes, recover his real typescript data XCTUU [MOVEM A,TPCNT(E)] ; and restore it in his block POP P,A XCTUU [MOVEM A,TPPTR(E)] QUEST4: PUSHJ P,RETYPE ; Go retype the input text JRST RESCAN ; And rescan to reinit processing ; Here we had a ? while entering a directory QDIR: PUSHJ P,QSDIR ; Append star and find first file QDIR0: PUSHJ P,GSIBE ; Any input? JRST QUEST1 ; Yes, retype and continue PUSHJ P,GDNAME ; Get the directory name ERRLJF GJFX17 ; Shouldn't happen HLRZ A,FILTMP(JFN) ; Print it on the next line PUSHJ P,QNXTL PUSHJ P,QVDIR0 ; Now look for the next directory JRST QUEST0 ; None left, retype JRST QDIR0 ; Go print it ; Here we had a ? while entering a name QNAM: TEST(NE,DIRSF) ; Any directory stars? JRST QUEST2 ; Yes, can't help him PUSHJ P,QSNAM ; Append star and find first file QNAM0: PUSHJ P,GSIBE ; Anything input? JRST QUEST1 ; Yes, quit HLRZ A,FILNEN(JFN) ; Print this name PUSHJ P,QNXTL PUSHJ P,QVNAM0 ; Now look for the next name JRST QUEST0 ; None left, beep and retype JRST QNAM0 ; go print it ; Here we had a ? while entering an extension QEXT: TEST(NE,DIRSF,NAMSF) ; Any directory or name stars? JRST QUEST2 ; Yes, can't help him PUSHJ P,QSEXT ; Append star and find first file QEXT0: PUSHJ P,GSIBE ; Anything input? JRST QUEST1 ; Yes, quit HRRZ A,FILNEN(JFN) ; Print this name MOVE B,1(A) ; Look at the first word of the string TLNE B,774000 ; If it is not null (first char 0) JRST QEXT1 ; Print it as is MOVEI A,[ASCIZ / [Null]/] ; Otherwise dummy an entry SUBI A,1 ; Set up as string block QEXT1: PUSHJ P,QNXTL PUSHJ P,QVEXT0 ; Now look for the next extension JRST QUEST0 ; None left, beep and retype JRST QEXT0 ; go print it ; Here we had a ? while entering a version QVER: TLNE F1,DIRSF!NAMSF!EXTSF ; Any dir, name, or ext stars? JRST QUEST2 ; Yes, can't help him PUSHJ P,QSVER ; Make it a star and find first file QVER0: PUSHJ P,GSIBE ; Anything input? JRST QUEST1 ; Yes, quit TMSG ; No, print this number HRRZ B,FILVER(JFN) PUSHJ P,DNOUT PUSHJ P,QVVER0 ; Now look for the next version JRST QUEST0 ; None left, beep and retype JRST QVER0 ; go print it ; Following are routines for stepping the Dir, Name, Ext, and Version ; fields and assuring that at least one file is accessible with the ; new field value. ; Return: +1 if none is found ; +2 if successful ; Step directory field QVDIR0: TEST(O,DIRSF,STEPF) ; Step the current directory number HRRZ A,FILDDN(JFN) PUSHJ P,@DLUKD(DEV) JFCL POPJ P, ; No more, return +1 HRRM A,FILDDN(JFN) ; Got one, store the new dir num PUSHJ P,USTDIR ; Release the directory PUSHJ P,QVNAM ; Now look for acceptable name, ext, ver JRST QVDIR0 ; None for this dir, step it JRST SKPRET ; Got one, return +2 ; Step name field QVNAM: SETZ A, ; Find the first name this dir JRST QVNAM1 QVNAM0: HLRZ A,FILNEN(JFN) ; Step the current name PUSHJ P,LKPTR ; Need a lookup ptr QVNAM1: TEST(O,NAMSF,STEPF) PUSHJ P,NAMLKX ; Find the next one JFCL POPJ P, ; No more, return +1 NOINT HRRZ A,FILTMP(JFN) ; Got one, exchange old name block HLRZ B,FILNEN(JFN) ; and new one HRLM A,FILNEN(JFN) HRRM B,FILTMP(JFN) OKINT PUSHJ P,SETTMP ; And reinit FILTMP ptr PUSHJ P,QVEXT ; Now look for acceptable ext and ver JRST QVNAM0 ; None for this name, step it JRST SKPRET ; Got one, return +2 ; Step extension field QVEXT: SETZ A, ; Find the first ext this name JRST QVEXT1 QVEXT0: HRRZ A,FILNEN(JFN) ; Step the current extension PUSHJ P,LKPTR ; Need a lookup ptr QVEXT1: TEST(O,EXTSF,STEPF) PUSHJ P,EXTLKX ; Find the next one JFCL POPJ P, ; No more, return +1 NOINT HRRZ A,FILTMP(JFN) ; Got one, exchange old ext block HRRZ B,FILNEN(JFN) ; and new one HRRM A,FILNEN(JFN) HRRM B,FILTMP(JFN) OKINT PUSHJ P,SETTMP ; And reinit FILTMP ptr PUSHJ P,QVVER ; Now look for acceptable ver JRST QVEXT0 ; None for this ext, step it JRST SKPRET ; Got one, return +2 ; Step version field QVVER: SETZ A, ; Find the first version this ext JRST QVVER1 QVVER0: HRRZ A,FILVER(JFN) ; Step the current version QVVER1: TEST(O,VERSF,STEPF) PUSHJ P,GTVER ; Go find next one and check access POPJ P, ; None, return +1 JRST SKPRET ; Finally we have an acceptable one ; Return +2 ; Routine to skip if input buffer is empty. ; Entry: From ? routines ; Call: PUSHJ P,GSIBE ; Return: +1, input not empty or non TTY ; +2, TTY input empty ; Clobbers A GSIBE: PUSHJ P,INFTST ; Check input JFN POPJ P, ; Nope, return +1 SIBE POPJ P, AOS 0(P) POPJ P, ; This routine appends a * to the field currently being entered and ; fakes *'s for any remaining fields. ; Entry: Partial input from user ; Call: PUSHJ P,QSDIR directory being entered ; PUSHJ P,QSNAM name being entered ; PUSHJ P,QSEXT extension being entered ; PUSHJ P,QSVER version being entered ; Return: +1 always, fake input fields set up QSDIR: PUSHJ P,QSTAR ; Add a star PUSHJ P,ENDDIR ; And find a directory QSNAM: PUSHJ P,QSTAR ; Add a star PUSHJ P,ENDNAM ; And find a name QSEXT: PUSHJ P,QSTAR ; Add a star PUSHJ P,ENDEXT ; And find an extension QSVER: PUSHJ P,QSTAR ; Make a star version PUSHJ P,ENDEXT ; And find a version POPJ P, ; Return ; Routine to fake a "*" input by user. ; Entry: Partial input in buffers ; Call: PUSHJ P,QSTAR ; Return: +1 always, * added to input buffers and old file flag set QSTAR: MOVEI A,"*" PUSHJ P,LTR ; Put it in FILTMP PUSHJ P,RTPCH ; And retype buffer (to rescan wild card) TEST(O,STARF) TEST(O,ASTAF) ; Make the * legal for now TEST(Z,OUTPF,NEWNF) ; Only look for old files TEST(O,OLDNF) POPJ P, ; Routine to print out a candidate string ; Entry: A = address of string block ; Call: PUSHJ P,QNXTL ; Return: +1 always ; Clobbers A,B,C QNXTL: PUSH P,A ; Save block adr for now TMSG POP P,B PUSHJ P,TSTRB ; Output string POPJ P, ; Routine to compute a lookup pointer for a string block: ; Entry: A = Address of block ; Call: PUSHJ P,LKPTR ; Return: +1, A = lookup pointer: -# words,,first word - 1 ; Clobbers A,B,C LKPTR: HRRZI B,1(A) ; Address of start of string HRLI B,440700 ; Make it a pointer ILDB C,B ; Find end of string JUMPN C,.-1 HRRZ C,A ; Start of block SUBI C,-1(B) ; -number of words HRL A,C ; Make A an IOWD POPJ P, ; Routine to fetch a directory name string, given the directory number ; Entry: Dir number in RH(FILDDN) ; Call: PUSHJ P,GDNAME ; Return: +1 Name not found ; +2 Name found and string in temp tmp block - LH(FILTMP) ; Clobbers A,B,C,D GDNAME: PUSHJ P,SELTMP ; Get a block HRRZ A,FILDDN(JFN) ; Dir number to find JUMPE A,GDNAM0 ; None there PUSHJ P,GDIRST ; Find the name JRST GDNAM0 ; Error, not found HLRZ B,FILTMP(JFN) ; Ptr in A, move it to temp tmp PUSHJ P,BBLT PUSHJ P,USTDIR ; Unlock the directory AOS 0(P) ; And return +2 POPJ P, GDNAM0: PUSHJ P,RELTMP ; Bad news, release the temp tmp block POPJ P, ; And return +1 ; Routine to BLT a block from one place to another ; Entry: A = Address of source block ; B = Address of destination block ; Call: PUSHJ P,BBLT ; Return: +1 always ; Clobbers A,B,C,D BBLT: HRRE C,0(A) ; Get origin block size HRRE D,0(B) ; And the dest block size CAMLE C,D ; Pick the smallest MOVE C,D HRLI A,1(A) ; Make BLT pointer HRRI A,1(B) ADDI B,-1(C) ; Stopping location CAILE C,1 ; If non-trivial block, do copy BLT A,0(B) ; Move it POPJ P, ; Set up temporary TMP storage using the left half of FILTMP. If a ; block is already assigned, don't disturb it. ; Entry: n/a ; Call: PUSHJ P,SELTMP ; Return: +1 always, tmp block set up in LH(FILTMP) SELTMP: HLRZ A,FILTMP(JFN) ; Is anything there now? JUMPN A,CPOPJ ; Yes, keep it MOVEI B,MAXLW+1 ; No, make a new one NOINT PUSHJ P,ASGJFR JRST [OKINT ; Bad luck ERRLJF GJFX22] HRLM A,FILTMP(JFN) ; Got it - save location OKINT POPJ P, ; Release the temporary TMP storage from the left half of FILTMP ; Entry: Tmp block ptr in LH(FILTMP) ; Call: PUSHJ P,RELTMP ; Return: +1 always RELTMP: MOVEI A,JSBFRE ; Free space location HLRZ B,FILTMP(JFN) NOINT SKIPE B ; If it is there PUSHJ P,RELFRE ; Release it HRRZS FILTMP(JFN) OKINT POPJ P, ; Set up a retype buffer and user control flags in the RH(FILEXW). Set ; up procedure is like SETTMP but block has more entries: ; ; Word 0 = Header ; 1 = Current byte ptr to last char entered in the block ; 2 = Current count of chars that can be added to the buffer ; (excludes the terminating 0 - always room for that) ; 3 = Current byte ptr into user typescript buffer ; 4 = Current count of space remaining in user typescript buffer ; 5 = Flags for non-std Dev or Dir and extended user output ; 6 = Start of input text ; Entry: n/a ; Call: PUSHJ P,SETRTP ; Return: +1 always, buffer allocated and initialized SETRTP: HRRZ A,FILEXW(JFN) ; Get ptr to existing buffer if there JUMPN A,SETRT0 ; If already allocated, just init it MOVEI B,MAXRW ; Need to allocate one, this many words NOINT PUSHJ P,ASGJFR JRST [OKINT ; Bad luck ERRLJF GJFX22] HRRM A,FILEXW(JFN) ; Got it, save the address OKINT SETRT0: MOVEI B,BLKDT(A) ; Set up starting string ptr HRLI B,440700 MOVEM B,BLKBP(A) ; And save it MOVEI B,MAXRC ; Set up max char count MOVEM B,BLKCT(A) ; And save it MOVSI C,LITRF ; Start with literal retype TLNN E,777777 ; Long GTJFN? TEST(NN,LLTBF) ; Yes, long-long table set? JRST SETRT2 ; No, just save what we have XCTUU [HLR C,EXTWD(E)] ; Yes, get his added flags in RH of BLKFG XCTUU [HRRE D,EXTWD(E)] ; And the number of following words CAIGE D,2 ; Enough for typescript stuff? JRST SETRT2 ; No, forget it XCTUU [MOVE B,TPPTR(E)] ; Yes, get user's string ptr TLCN B,777777 ; Any kind of ptr? JRST SETRT1 ; No, try prompt ptr TLCN B,777777 ; If implicit, set it up HRLI B,440700 IFN KIFLG,< TLNE B,37 ; If KI-10, can't have indir or index JRST SETRT1 ; Bad news, ignore his request > MOVEM B,USRBP(A) ; Save his ptr in our buffer XCTUU [SKIPG B,TPCNT(E)] ; Now look at his count MOVEI B,MAXRC ; If non-pos, use our default MOVEM B,USRCT(A) ; Save his max count in our buffer TLO C,USRTY ; And set bit to show he wants it SETRT1: CAIGE D,3 ; Enough for a prompt pointer? JRST SETRT2 ; No, forget it XCTUU [MOVE B,PRPTR(E)] ; Get his prompt pointer TLCN B,777777 ; Any kind of pointer? JRST SETRT2 ; No, wrap it up TLCN B,777777 ; If implicit, set it up HRLI B,440700 IFN KIFLG,< TLNE B,37 ; If KI-10, can't have indir or index JRST SETRT2 ; Bad news, forget it > XCTUU [MOVEM B,PRPTR(E)] ; Give it back to him TLO C,USRPR ; And set bit to show he has one SETRT2: MOVEM C,BLKFG(A) ; Now store the bits POPJ P, ; And return ; Cleanup on error. Make sure user typescript terminated, if any, and ; release the JFN. ; Entry: Error condition, JFN block partly complete ; Call: PUSHJ P,ENDJFN ; Return: +1 always ENDJFN: PUSHJ P,TRMUTP ; Terminate user typescript if needed JRST RELJFN ; And then release JFN ; Routine to terminate a user typescript. ; Entry: Retype buffer set up ; Call: PUSHJ P,TRMUPT ; Return: +1 always TRMUTP: MOVEI A,0 ; Make sure user's typescript has 0 PUSHJ P,USRCH HRRZ A,FILEXW(JFN) ; Get the retype buffer ptr SKIPG A ; if one still there POPJ P, MOVE C,BLKFG(A) ; and give typescr ptr and count back to TLNN C,USRTY ; the user if he wanted it POPJ P, MOVE B,USRBP(A) XCTUU [MOVEM B,TPPTR(E)] MOVE B,USRCT(A) XCTUU [MOVEM B,TPCNT(E)] POPJ P, ; Routine to copy a string from a trimmed block back to a full-sized ; block, releasing the trimmed block. Returns NOINT always. ; Entry: A = address of trimmed block ; Call: PUSHJ P,FULBLK ; Return: +1 always, A = new full sized block address, NOINT ; Clobbers A,B,C,D FULBLK: NOINT HRRZ B,0(A) ; Size of old block CAIL B,MAXLW+1 ; Full sized already? POPJ P, ; Yes, return PUSH P,A ; No, save old block address MOVEI B,MAXLW+1 ; Get a new block of full size PUSHJ P,ASGJFR JRST [OKINT ; Bad luck, no more room ERRLJF GJFX22] SETZM 1(A) ; Make sure at least one 0 MOVE B,A ; Set up to copy old block MOVE A,0(P) PUSH P,B PUSHJ P,BBLT POP P,B MOVEI A,JSBFRE ; Done, now release the old one EXCH B,0(P) PUSHJ P,RELFRE POP P,A ; And return the new adr in A POPJ P, ; Output a char to the retype buffer and to the user typescript. ; Entry: A = Character to be output ; Call: PUSHJ P,RTPCH Output to both retype and user ; PUSHJ P,USRCH Output to user only ; Return: +1 always ; Clobbers A,B,C RTPCH: TEST(NE,RSCNF) ; If rescan pending, don't touch retype JRST USRCH ; Just go do the user typescript HRRZ B,FILEXW(JFN) ; Get retype buffer address SKIPG B ; Anything there? POPJ P, ; No, return SOSGE BLKCT(B) ; Enough room? ERRLJF GJFX41 ; No, bomb out IDPB A,BLKBP(B) ; Yes, store it USRCH: HRRZ B,FILEXW(JFN) ; Get retype buffer address (may enter here) SKIPG B ; Anything there? POPJ P, ; No, return MOVE C,BLKFG(B) ; And the flags TLNN C,USRTY ; Typescript wanted and legal? POPJ P, ; No, return SOSGE USRCT(B) ; Enough room? JRST [TLZ C,USRTY ; No, turn off flag for more MOVEM C,BLKFG(B) XCTUU [SETOM TPCNT(E)] ; Neg count to let him know POPJ P,] MOVE C,USRBP(B) ; Get user byte ptr XCTBU [IDPB A,C] ; Put the byte in his buffer JUMPE A, [AOS USRCT(B) ; 0 byte, reset his count POPJ P,] ; And don't update the pointer MOVEM C,USRBP(B) ; Resave byte ptr POPJ P, ; Output a string to the retype buffer and to the user typescript ; Entry: A = Address of the string block ; Call: PUSHJ P,RTSTRB print from string block ; ; Entry: A = String pointer to source ; Call: PUSHJ P,RTSTR print from string pointer ; ; Return: +1 always ; Clobbers A,B,C,D RTSTRB: HRROI A,1(A) ; Address string part of block RTSTR: TLC A,777777 ; If implicit, set it up TLCN A,777777 HRLI A,440700 HRRZ B,FILEXW(JFN) ; Address of retype buffer SKIPG B ; Anything there? POPJ P, ; No, return PUSH P,A ; Save copy of ptr for later TEST(NE,RSCNF) ; Rescan in progress? JRST RTSTR1 ; Yes, don't touch the retype buffer RTSTR0: ILDB C,A ; Get input character JUMPE C,RTSTR1 ; End if 0 SOSGE BLKCT(B) ; Room for real char? ERRLJF GJFX41 ; No, bomb out IDPB C,BLKBP(B) ; Put char in retype buffer JRST RTSTR0 ; And do them all RTSTR1: POP P,A ; Recover ptr to start of input string MOVE C,BLKFG(B) ; Get retype flags TLNN C,USRTY ; Typescript wanted POPJ P, ; No, return now MOVE C,USRBP(B) ; Get byte ptr to user buffer RTSTR2: ILDB D,A ; Get input char JUMPE D,[MOVEM C,USRBP(B) ; Save user's byte ptr POPJ P,] SOSGE USRCT(B) ; Room in user's buffer? JRST [MOVEM C,USRBP(B) ; No, save current byte ptr MOVE C,BLKFG(B) ; Get flags TLZ C,USRTY ; Turn off flag for more MOVEM C,BLKFG(B) XCTUU [SETOM TPCNT(E)] ; Neg count to let him know POPJ P,] XCTBU [IDPB D,C] ; Put the byte in his buffer JRST RTSTR2 ; Go do them all ; Output a number to the retype buffer and the user typescript ; Entry: B = number ; C = radix ; Call: PUSHJ P,RTNOUT ; Return: +1 always ; Clobbers A,B,C,D RTNOUT: MOVEI A,1 ; Compute biggest number MOVEI D,NDIG ; this many digits RTNOU0: IMUL A,C SOJG D,RTNOU0 PUSH P,A ; Save divisor PUSH P,B ; Number to be converted PUSH P,C ; And the radix SKIPGE B ; Negative value? JRST [MOVMM B,-1(P) ; Convert to magnitude CHRTP("-") ; Put out sign JRST .+1] MOVE A,-1(P) ; Fetch the number CAML A,-2(P) ; Less than biggest? JRST [RTPMSG("***") ; No, do stars JRST RTNOU3] RTNOU1: PUSHJ P,GTDIG ; Go compute a digit JRST [CHRTP("0") ; Just a 0 JRST RTNOU3] CAIN A,"0" ; Anything but 0? JRST RTNOU1 ; No, look some more RTNOU2: PUSHJ P,RTPCH ; OK, go type the char PUSHJ P,GTDIG ; get another digit JRST RTNOU3 ; No more, quit JRST RTNOU2 RTNOU3: SUB P,[3,,3] ; Reset stack POPJ P, ; Routine to compute the next digit from data on the stack: ; Entry: 0(P) = return address ; -1(P) = radix ; -2(P) = current remainder ; -3(P) = current divisor ; Call: PUSHJ P,GTDIG ; Return: +1, no more characters ; +2, A = next character GTDIG: MOVE A,-2(P) ; Get current number MOVE C,-3(P) ; Get current divisor IDIV C,-1(P) ; Compute new divisor SKIPG C POPJ P, ; Nothing left MOVEM C,-3(P) ; Save new divisor IDIV A,C ; Compute next char MOVEM B,-2(P) ; Save new remainder IORI A,60 ; Convert to character JRST SKPRET ; And return +2 END